COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	% This program by D. E. Knuth is not copyrighted and can be used freely.
C00004 00003	@* Introduction.
C00010 00004	@* The character set.
C00015 00005	@* Binary I/O.
C00018 00006	@* The main program.
C00022 00007	@* Index.
C00033 ENDMK
C⊗;
% This program by D. E. Knuth is not copyrighted and can be used freely.

% Here is TeX material that gets inserted after \input webmac
\def\title{MONA}
\magnify{\magstep1}
%\pagewidth=4.2truein % estimate to match CACM line length
\setpage
%\tolerance=1000

%\advance\topskip by \baselineskip	% doublespacing
%\advance\smallskipamount by \baselineskip
%\advance\baselineskip by \baselineskip

\def\con{\par\vfill\eject % finish the section names
  \rightskip 0pt \hyphenpenalty 50 \tolerance 200
  \setpage
  \output{\normaloutput\page\lheader\rheader}
  \titletrue % prepare to output the table of contents
  \pageno=\contentspagenumber \def\rhead{TABLE OF CONTENTS}
  \message{Table of contents:}
  \topofcontents
  \line{{\bf Sample}\hfil Section}
  \def\Z##1##2##3{\line{\ignorespaces##1
    \leaders\hbox to .5em{.\hfil}\hfil\hbox to2em{\hss##2}}}
  \readcontents\relax % read the contents info
  \botofcontents \end} % print the contents page(s) and terminate
@* Introduction.
This program is run once as I play with the Mona Lisa data.

@ Here's an outline of the entire Pascal program:

@p program mona(@!mona_file,@!bytes_out,@!output);
type @<Types in the outer block@>@/
var@?@<Global variables@>@/
@#
procedure initialize; {this procedure gets things started properly}
	var@?@<Local variables for initialization@>@/
	begin @<Set initial values@>@;
	end;@#
begin initialize; @<The main program@>;
end.
@* The character set.
We need translation tables between ASCII and the actual character
set, in order to make this program portable. The standard conventions of
{\sl \TeX: The Program\/} are copied here, essentially verbatim.

@d text_char == char {the data type of characters in text files}
@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
@d last_text_char=127 {ordinal number of the largest element of |text_char|}

@<Types...@>=
@!ASCII_code=0..127; {seven-bit numbers}

@ @<Glob...@>=
@!xord: array [text_char] of ASCII_code;
	{specifies conversion of input characters}
@!xchr: array [ASCII_code] of text_char;
	{specifies conversion of output characters}

@ @<Set init...@>=
xchr[@'40]←' ';
xchr[@'41]←'!';
xchr[@'42]←'"';
xchr[@'43]←'#';
xchr[@'44]←'$';
xchr[@'45]←'%';
xchr[@'46]←'&';
xchr[@'47]←'''';@/
xchr[@'50]←'(';
xchr[@'51]←')';
xchr[@'52]←'*';
xchr[@'53]←'+';
xchr[@'54]←',';
xchr[@'55]←'-';
xchr[@'56]←'.';
xchr[@'57]←'/';@/
xchr[@'60]←'0';
xchr[@'61]←'1';
xchr[@'62]←'2';
xchr[@'63]←'3';
xchr[@'64]←'4';
xchr[@'65]←'5';
xchr[@'66]←'6';
xchr[@'67]←'7';@/
xchr[@'70]←'8';
xchr[@'71]←'9';
xchr[@'72]←':';
xchr[@'73]←';';
xchr[@'74]←'<';
xchr[@'75]←'=';
xchr[@'76]←'>';
xchr[@'77]←'?';@/
xchr[@'100]←'@@';
xchr[@'101]←'A';
xchr[@'102]←'B';
xchr[@'103]←'C';
xchr[@'104]←'D';
xchr[@'105]←'E';
xchr[@'106]←'F';
xchr[@'107]←'G';@/
xchr[@'110]←'H';
xchr[@'111]←'I';
xchr[@'112]←'J';
xchr[@'113]←'K';
xchr[@'114]←'L';
xchr[@'115]←'M';
xchr[@'116]←'N';
xchr[@'117]←'O';@/
xchr[@'120]←'P';
xchr[@'121]←'Q';
xchr[@'122]←'R';
xchr[@'123]←'S';
xchr[@'124]←'T';
xchr[@'125]←'U';
xchr[@'126]←'V';
xchr[@'127]←'W';@/
xchr[@'130]←'X';
xchr[@'131]←'Y';
xchr[@'132]←'Z';
xchr[@'133]←'[';
xchr[@'134]←'\';
xchr[@'135]←']';
xchr[@'136]←'↑';
xchr[@'137]←'_';@/
xchr[@'140]←'`';
xchr[@'141]←'a';
xchr[@'142]←'b';
xchr[@'143]←'c';
xchr[@'144]←'d';
xchr[@'145]←'e';
xchr[@'146]←'f';
xchr[@'147]←'g';@/
xchr[@'150]←'h';
xchr[@'151]←'i';
xchr[@'152]←'j';
xchr[@'153]←'k';
xchr[@'154]←'l';
xchr[@'155]←'m';
xchr[@'156]←'n';
xchr[@'157]←'o';@/
xchr[@'160]←'p';
xchr[@'161]←'q';
xchr[@'162]←'r';
xchr[@'163]←'s';
xchr[@'164]←'t';
xchr[@'165]←'u';
xchr[@'166]←'v';
xchr[@'167]←'w';@/
xchr[@'170]←'x';
xchr[@'171]←'y';
xchr[@'172]←'z';
xchr[@'173]←'{';
xchr[@'174]←'|';
xchr[@'175]←'}';
xchr[@'176]←'~';@/
xchr[0]←' '; xchr[@'177]←' ';
	{ASCII codes 0 and |@'177| do not appear in text}

@ Some of the ASCII codes without visible characters have been given symbolic
names in this program because they are used with a special meaning.

@d null_code=@'0 {ASCII code that might disappear}
@d carriage_return=@'15 {ASCII code used at end of line}
@d invalid_code=@'177 {ASCII code that should not appear}

@ @<Local variables for init...@>=
i:0..last_text_char;

@ @<Set init...@>=
for i←1 to @'37 do xchr[i]←' ';
for i←first_text_char to last_text_char do xord[chr(i)]←invalid_code;
for i←1 to @'176 do xord[xchr[i]]←i;
@* Binary I/O.
Here are things copied from \TeX ware, to read and write the binary files.

@<Types...@>=
@!eight_bits=0..255; {unsigned one-byte quantity}
@!byte_file=packed file of eight_bits; {files that contain binary data}

@ @<Glob...@>=
@!mona_file:byte_file;
@!bytes_out:byte_file;
@* The main program.
The input has $360\times250$ bytes, with \.{00} representing black and
\.{FF} representing white. These pixels are square.
Mona Lisa can be found in rows |18..308|, columns |1..250|.
We wish to expand this into $512\times440$ bytes, and also to
make a condensed file that compresses $8\times8$ squares into
five-bit densities.

@<Glob...@>=
@!i,@!j,@!k,@!l,@!m:integer; {indices}
@!buf,@!prev_buf:array[1..250] of eight_bits;
@!out_buf:array[0..439] of eight_bits;
@!short_buf:array[0..54] of integer;
@!garbage:eight_bits;

@ Linear interpolation between pixels is handled by the variables
|jj|, which increases by 249 modulo 439, and |ii|, which increases
by 291 modulo 511.

@<Glob...@>=
@!ii,@!jj:integer;

@ @<The main program@>=
reset(mona_file,'','/B:8');
rewrite(bytes_out,'','/B:8');
write_ln('\font\f=tmphlf[hf,dek]');
write_ln('\parindent=0pt \offinterlineskip \obeylines \f');
for l:=1 to 250 do buf[l]:=0;
for i:=1 to 17 do @<Roll the buffer down@>;
ii:=511;
for i:=0 to 63 do @<Read and write eight lines@>;
write_ln('\bye')

@ @<Roll...@>=
begin for l:=1 to 250 do
	begin prev_buf[l]:=buf[l];
	read(mona_file,buf[l]);
	end;
end

@ @<Read and write...@>=
begin for k:=0 to 54 do short_buf[k]:=0;
for m:=0 to 7 do
	begin @<Read one line@>;
	for k:=0 to 54 do for l:=8*k to 8*k+7 do
		short_buf[k]:=short_buf[k]+out_buf[l];
	end;
for k:=0 to 54 do
	begin l:=short_buf[k] div 512;
	if l<10 then write(xchr["0"+l]) else write(xchr["A"+l-10]);
	end;
write_ln;
end

@ @<Read one...@>=
while ii≥511 do
	begin @<Roll...@>; ii←ii-511;
	end;
@<Interpolate from |prev_buf| and |buf| into |out_buf|@>;
for l:=0 to 439 do write(bytes_out,out_buf[l]);
ii:=ii+291

@ @<Interp...@>=
jj:=0; j:=1; l:=0;
repeat alpha:=prev_buf[j]; beta:=buf[j];
if jj>0 then
	begin alpha:=alpha+(jj/439)*(prev_buf[j+1]-prev_buf[j]);
	beta:=beta+(jj/439)*(buf[j+1]-buf[j]);
	end;
t:=round(alpha+(ii/511)*(beta-alpha));
if t>255 then out_buf[l]:=255
else if t<0 then out_buf[l]:=0
else out_buf[l]:=t;
l←l+1; jj:=jj+249;
if jj≥439 then
	begin j←j+1; jj←jj-439;
	end;
until l>439

@ @<Glob...@>=
@!alpha,@!beta:real;
@!t:integer;
@* Index.
Here are the quantities declared and/or used in the program.
(The uses of single-letter variables aren't indexed.)